unit Browser;

interface

uses
  Windows, Messages, SysUtils, Classes,
  {$IFDEF MSWINDOWS}
  Graphics, Controls, Forms,
  {$ELSE}
  QGraphics, QControls, QForms, 
  {$ENDIF}
  Dialogs,
  StdCtrls, ExtCtrls, Menus, ComCtrls, OleCtrls, Buttons, ToolWin, Isp3,
  ActnList, ImgList, shdocvw;

const
  CM_HOMEPAGEREQUEST = WM_USER + $1000;

type
  TWebBrowserFenster = class(TForm)
    StatusBar1: TStatusBar;
    NavigatorImages: TImageList;
    NavigatorHotImages: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    BackBtn: TToolButton;
    ForwardBtn: TToolButton;
    StopBtn: TToolButton;
    RefreshBtn: TToolButton;
    ToolBar2: TToolBar;
    Tabelle: TToolButton;
    Bestenliste: TToolButton;
    Doppelbestenliste: TToolButton;
    JedergegenJeden: TToolButton;
    URLs: TComboBox;
    ActionList1: TActionList;
    BackAction: TAction;
    ForwardAction: TAction;
    StopAction: TAction;
    RefreshAction: TAction;
    WebBrowser1: TWebBrowser;
    Ergebnisse: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    AlleSpieler: TToolButton;
    ToolButton1: TToolButton;
    Terminplan: TToolButton;
    HomeBtn: TToolButton;
    procedure Exit1Click(Sender: TObject);
    procedure StopClick(Sender: TObject);
    procedure URLsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure LinksClick(Sender: TObject);
    procedure RefreshClick(Sender: TObject);
    procedure BackClick(Sender: TObject);
    procedure URLsClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Toolbar3Click(Sender: TObject);
    procedure Statusbar2Click(Sender: TObject);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure WebBrowser1DownloadBegin(Sender: TObject);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure HomePageRequest(var message: tmessage); message CM_HOMEPAGEREQUEST;
    procedure HomeBtnClick(Sender: TObject);
    procedure WebBrowser1CommandStateChange(Sender: TObject;
      Command: Integer; Enable: WordBool);
    procedure ForwardBtnClick(Sender: TObject);
    procedure FindAddress;
  private
    UpdateCombo: Boolean;
    Zurueck, Vorwaerts : Integer;
  end;

var
  WebBrowserFenster: TWebBrowserFenster;

implementation

Uses Options, Klass;

{$R *.DFM}

procedure TWebBrowserFenster.Exit1Click(Sender: TObject);
begin
  Hide;
end;

procedure TWebBrowserFenster.FindAddress;
var
  Flags: OLEVariant;

begin
  Flags := 0;
  UpdateCombo := True;
  WebBrowser1.Navigate(WideString(Urls.Text)); 
end;

procedure TWebBrowserFenster.StopClick(Sender: TObject);
begin
  WebBrowser1.Stop;
end;

procedure TWebBrowserFenster.URLsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_Return then
  begin
    FindAddress;
  end;
end;

procedure TWebBrowserFenster.URLsClick(Sender: TObject);
begin
  FindAddress;
end;

procedure TWebBrowserFenster.LinksClick(Sender: TObject);
begin
  if (Sender as TToolButton).Hint = '' then Exit;
  URLs.Text := (Sender as TToolButton).Hint;
  FindAddress;
end;

procedure TWebBrowserFenster.RefreshClick(Sender: TObject);
begin
  WebBrowser1.Refresh;
end;

procedure TWebBrowserFenster.BackClick(Sender: TObject);
begin
  WebBrowser1.GoBack;
end;

procedure TWebBrowserFenster.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Shift = [ssAlt] then
    if (Key = VK_RIGHT) and ForwardBtn.Enabled then
      ForwardBtn.Click
    else if (Key = VK_LEFT) and BackBtn.Enabled then
      BackBtn.Click;
end;

procedure TWebBrowserFenster.Toolbar3Click(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    Coolbar1.Visible := Checked;
  end;
end;

procedure TWebBrowserFenster.Statusbar2Click(Sender: TObject);
begin
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    StatusBar1.Visible := Checked;
  end;
end;

procedure TWebBrowserFenster.HomePageRequest(var Message: TMessage);
begin
  {$IFDEF MSWINDOWS}
  If FileExists( Klasse.HtmlVerzeichnis + '\INDEX.HTM' ) then
   URLs.Text := Klasse.HtmlVerzeichnis + '\INDEX.HTM'
  else URLs.Text := Klasse.HtmlVerzeichnis + '\TAB.HTM';
  If Showing then FindAddress;
  {$ELSE}
  If FileExists( Klasse.HtmlVerzeichnis + '/INDEX.HTM' ) then
   URLs.Text := Klasse.HtmlVerzeichnis + '/INDEX.HTM'
  else URLs.Text := Klasse.HtmlVerzeichnis + '/TAB.HTM';
  If Showing then FindAddress;
  {$ENDIF}
end;

procedure TWebBrowserFenster.FormCreate(Sender: TObject);
begin
  { Find the home page - needs to be posted because HTML control hasn't been
    registered yet. }
  PostMessage(Handle, CM_HOMEPAGEREQUEST, 0, 0);
end;

procedure TWebBrowserFenster.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
var
  NewIndex: Integer;
begin
  if UpdateCombo then
  begin
    UpdateCombo := False;
    NewIndex := URLs.Items.IndexOf(URL);
    if NewIndex = -1 then
      URLs.Items.Insert(0, URL)
    else
      URLs.Items.Move(NewIndex, 0);
    URLs.Text := URL;
    Statusbar1.Panels[0].Text := URL;
  end;
end;

procedure TWebBrowserFenster.WebBrowser1DownloadBegin(Sender: TObject);
begin
  { Turn the stop button dark red }
  StopBtn.ImageIndex := 5;
end;

procedure TWebBrowserFenster.WebBrowser1DownloadComplete(Sender: TObject);
begin
  { Turn the stop button grey }
  StopBtn.ImageIndex := 2;
end;

procedure TWebBrowserFenster.ToolButton3Click(Sender: TObject);
begin
  Hide;
end;

procedure TWebBrowserFenster.HomeBtnClick(Sender: TObject);
Var Meldung : TMessage;
begin
 HomePageRequest( Meldung );
end;

procedure TWebBrowserFenster.WebBrowser1CommandStateChange(Sender: TObject;
  Command: Integer; Enable: WordBool);
begin
  case Command of
    CSC_NAVIGATEBACK: BackBtn.Enabled := Enable;
    CSC_NAVIGATEFORWARD: ForwardBtn.Enabled := Enable;
  end;
end;

procedure TWebBrowserFenster.ForwardBtnClick(Sender: TObject);
begin
  WebBrowser1.GoForward;
end;

end.
